home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / PROGS / MAKEMEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  8KB  |  271 lines
  1. PROGRAM MAKEMEMO;
  2.  
  3. {$M 20000,0,655000}
  4.  
  5. Uses DOS, PbMISC, PbDATA, PbOBJS, PbHIGH, PbPARMS, PbOUT0,
  6.           PbDBOBJ, PbMEMO, PbDBLIB;
  7.  
  8. {
  9. Description : Takes sectioned file and produces simple DBF and MEMO files
  10.  
  11. Author      : Howard Richoux
  12. Date        : 12/20/93
  13. Last revised: 12/25/93 hnr PbOUT output
  14. Application : IBM PC and compatibles, done in Turbo Pascal 7.0
  15. Status      : Placed in the Public Domain by HNR Software 1/29/94
  16. Published in: none
  17.  
  18. DBF file is probably of the form(specified by DBFSPEC):
  19.    FILENAME   C12
  20.    FILEDATE   Date
  21.    FILEEOF    N8.0
  22.    SECTNAME   C24
  23.    LINES      N5
  24.    TEXT       Memo
  25.  
  26. Config Parameters        meaning                    default
  27. DBFNAME=<fname>          create <fname>             TEST.DBF
  28.                                                     TEST.DBT
  29. DBFSPEC=[...]            dbf field specifications
  30.   [FILENAME(C12),FILEDATE(D),FILEEOF(N8.0),SECTNAME(C24),LINES(N5),TEXT(M)]
  31.  
  32. }
  33.  
  34.  
  35. var DBF      : DBF_object;
  36.     MEMOFILE : MEMO_object;
  37.     MEMO     : STRA_object;
  38.  
  39. var dbfname : string;    { Name of DBF file  }
  40.     memname : string;    { Name of MEMO file }
  41.     dbfspec : string;    { DBF fields }
  42.     secttag : string;    { text file section designator }
  43.     err     : integer;   { general use }
  44.  
  45. var workspec : string;
  46.     worklist : STRA_object;
  47.  
  48.  
  49. var filename : string;
  50.     fileeof  : longint;
  51.     filedate : string;
  52.     sectname : string;
  53.     lines    : integer;
  54.     sr       : searchrec;
  55.  
  56. {*****************************************************************}
  57.  
  58.  
  59. Procedure SetFileInfo(fname : string);
  60. var err : integer;
  61.      begin
  62.      sectname   := '<none>';
  63.      filedate   := '19931231';
  64.      fileeof    := 9999;
  65.      filename   := '<filename>';
  66.      err := FileInfo(fname,'',sr);
  67.      if err = 0 then
  68.           begin
  69.           filedate   := PTimeToDBase(sr.time);
  70.           fileeof    := sr.size;
  71.           filename   := sr.name;
  72.           end;
  73.      end;
  74.  
  75.  
  76. Function AddDBFRecord(var D : DBF_object;
  77.                   fname,sname,fdate : string; eof,mnum : longint):boolean;
  78. var i,err : integer;
  79.     ok    : boolean;
  80.      begin
  81.      D.dbf.dbcleardbbuf;
  82.      i := D.dbf.dbfldno('FILENAME');
  83.      if i > 0 then D.dbf.dbputstr(i,fname);
  84.      i := D.dbf.dbfldno('SECTNAME');
  85.      if i > 0 then D.dbf.dbputstr(i,sname);
  86.      i := D.dbf.dbfldno('FILEDATE');
  87.      if i > 0 then D.dbf.dbputdate(i,fdate);
  88.      i := D.dbf.dbfldno('FILEEOF');
  89.      if i > 0 then D.dbf.dbputlong(i,eof);
  90.      i := D.dbf.dbfldno('LINES');
  91.      if i > 0 then D.dbf.dbputint(i,lines);
  92.      i := D.dbf.dbfldno('TEXT');
  93.      if i > 0 then D.dbf.dbputlong(i,mnum);
  94.      ok := D.dbf.dbappend;
  95.      if ok then writeln('DBF record added ok.',sname)
  96.      else       writeln('DBF record add ERR  ',sname,'  ',err);
  97.      end;
  98.  
  99.  
  100. Function CreateDBFfile : boolean;
  101.      begin
  102.      CreateDBFfile := true;
  103.      writeln('dbfname: ',dbfname);
  104.      writeln('dbfspec: ',dbfspec);
  105.      if not DBFCreateFile(dbfname,dbfspec,err) then
  106.           begin
  107.           writeln('Create error ',err);
  108.           CreateDBFfile := false;
  109.           end
  110.      else begin
  111.           DBF.init(dbfname,0,fREADWRITE);
  112.           if DBF.opened then writeln('DBF opened')
  113.           else writeln('DBF open err ',dbf.err);
  114.           end;
  115.      end;
  116.  
  117.  
  118. Function CreateMEMOfile : boolean;
  119.      begin
  120.      CreateMEMOfile := true;
  121.      if fileexists(memname) then
  122.           begin
  123.           writeln('MEMO file already exists [',memname,']');
  124.           exit;
  125.           end;
  126.      writeln('Creating memoname: ',memname);
  127.      MEMOFILE.init(memname,fCREATE);
  128.      MEMOFILE.done;
  129.      if not fileexists(memname) then
  130.           begin
  131.           writeln('MEMO file not found - Create error ',err);
  132.           CreateMEMOfile := false;
  133.           end
  134.      else begin
  135.           MEMOFILE.init(memname,fREADWRITE);
  136.           if MEMOFILE.NoError then writeln('MEMO created ok.');
  137.           end;
  138.      end;
  139.  
  140.  
  141. Procedure HandleMEMO(var memo : STRA_object);
  142. var ndx : longint;
  143.     blocks : integer;
  144.      begin
  145.      ndx := -1;
  146.      blocks := 0;
  147.      MEMOFILE.append(MEMO,ndx,blocks);
  148.     { writeln('After MEMO appending at ',ndx,'  ',blocks);}
  149.      lines := MEMO.count;
  150.      MEMO.append(chr($1A)); {end of MEMO}
  151.      if not AddDBFRecord(DBF,filename,sectname,filedate,
  152.                               fileeof,ndx) then
  153.           begin
  154.           writeln('AddDBFRecord failed.');
  155.           end;
  156.      MEMO.done;
  157.      end;
  158.  
  159.  
  160. Procedure ProcessLine(str : string);
  161. var s : string;
  162.      begin
  163.      s := str;
  164.      if secttag = UpCaseStr(leftstr(s,length(secttag))) then
  165.           begin
  166.           if MEMO.count > 0 then HandleMEMO(MEMO);
  167.           MEMO.init(1000);
  168.           delete(s,1,length(secttag));
  169.           sectname := GetLeftStr(s,' ');
  170.           sectname := UpCaseStr(sectname);
  171.           end;
  172.      MEMO.append(str+chr($0D)+chr($8A));
  173.      end;
  174.  
  175.  
  176. Function OpenOrCreateFiles : boolean;
  177.      begin
  178.      OpenOrCreateFiles := true;
  179.      if DBFValidDBFfile(dbfname) then
  180.           begin
  181.           DBF.init(dbfname,0,fREADWRITE);
  182.           if DBF.opened then writeln('DBF opened')
  183.           else writeln('DBF open err ',dbf.err);
  184.           end
  185.      else if not CreateDBFfile then  OpenOrCreateFiles := false;
  186.      if fileExists(memname) then
  187.           begin
  188.           writeln('MEMO file exists');
  189.           MEMOFILE.init(memname,fREADWRITE);
  190.           if not MEMOFILE.opened then OpenOrCreateFiles := false;
  191.           writeln('MEMO records ',memofile.count);
  192.           end
  193.      else if not CreateMEMOfile then OpenOrCreateFiles := false;
  194.      end;
  195.  
  196.  
  197. Procedure ProcessFile(fname : string);      { Initialization is over, do some work.}
  198.      begin
  199.      pCurrFName := fname;
  200.      if not FileExists(pCurrFName) then
  201.           begin
  202.           writeln('Input file does not exist [',pCurrFName,']');
  203.           exit;
  204.           end;
  205.      if OpenOrCreateFiles then
  206.           begin
  207.         {  OutPause; }
  208.           SetFileInfo(pCurrFName);
  209.           writeln('secttag [',secttag,']');
  210.           MEMO.init(1000);    { holding spot for memos }
  211.           ReadTEXTFile(pCurrFName,Processline);
  212.           if MEMO.count > 0 then HandleMEMO(MEMO);
  213.           MEMOFILE.done;
  214.           DBF.done;
  215.           end;
  216.      end;
  217.  
  218.  
  219. Procedure GoOn;
  220. var i : integer;
  221.      begin
  222.      for i := 1 to worklist.count do
  223.            ProcessFile(worklist.fetchN(i));
  224.      end;
  225.  
  226.  
  227. Procedure Init;
  228. var s : string;
  229.      begin
  230.      AddParm(1,'SECTTAG','{SECTION');
  231.      AddParm(1,'DBFNAME','TEST.DBF');
  232.      AddParm(1,'DBFSPEC',
  233.       '[FILENAME(C12),FILEDATE(D),FILEEOF(N8.0),SECTNAME(C24),LINES(N5),TEXT(M)]');
  234.  
  235.      StandardOUTInit;                    { also calls StandardpVarsInit }
  236.  
  237.      dbfname := GetParmStr('DBFNAME');
  238.      dbfspec := GetParmStr('DBFSPEC');
  239.      memname := dbfname;
  240.      ForceExt(memname,'DBT');
  241.      secttag := UpCaseStr(GetParmStr('SECTTAG'));
  242.  
  243.      worklist.init(100);
  244.      if paramcount > 0 then
  245.           begin
  246.           workspec := UpCaseStr(paramstr(1));
  247.           GetFilesSTRA(workspec,worklist,fsortbyname);
  248.           worklist.dump;
  249.           end;
  250.      end;
  251.  
  252.  
  253.  
  254. (*  Main program *)
  255.      BEGIN
  256.      pProgID := 'MAKEMEMO 1.00';
  257.      Init;
  258.  
  259.      if worklist.count > 0 then
  260.           begin
  261.           GoOn;
  262.           end
  263.      else begin
  264.           writeln('** No input file(s) specified. [',workspec,']');
  265.           ShowDocFile;
  266.           end;
  267.      OUTdone;
  268.      end.
  269.  
  270.  
  271.